***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
Set Printer to PRN                                                                                                                                                                                                                                        
Set print on                                                                                                                                                                                                                                              
set device to printer                                                                                                                                                                                                                                     
setprc(0,0)                                                                                                                                                                                                                                               
STORE 0 TO TOTMED,TOTPHR,TOTALL                                                                                                                                                                                                                           
page = 0                                                                                                                                                                                                                                                  
a=year(date())                                                                                                                                                                                                                                            
* a=substr(str(a,4),3,2)                                                                                                                                                                                                                                    
mstop = .f.                                                                                                                                                                                                                                               
BB = 3                                                                                                                                                                                                                                                    
AA = 2                                                                                                                                                                                                                                                    
SELE 3                                                                                                                                                                                                                                                    
f3='ph'+kdpat                                                                                                                                                                                                                                             
use &dr&f3                                                                                                                                                                                                                                                
n2=reccount()                                                                                                                                                                                                                                             
l2 = reccount()/8                                                                                                                                                                                                                                         
lx2= int(l2)                                                                                                                                                                                                                                              
GO TOP                                                                                                                                                                                                                                                    
SELE 2                                                                                                                                                                                                                                                    
n1=reccount()                                                                                                                                                                                                                                             
l1 = reccount()/5                                                                                                                                                                                                                                         
lx1= int(l1)                                                                                                                                                                                                                                              
GO TOP                                                                                                                                                                                                                                                    
if l1 > l2                                                                                                                                                                                                                                                
   IF LX1 = 0                                                                                                                                                                                                                                             
      tot_pg = 1                                                                                                                                                                                                                                          
   ELSE                                                                                                                                                                                                                                                   
      if MOD(n1,5)#0                                                                                                                                                                                                                                      
         tot_pg = lx1+1                                                                                                                                                                                                                                   
      else                                                                                                                                                                                                                                                
         tot_pg = lx1                                                                                                                                                                                                                                     
      endif                                                                                                                                                                                                                                               
   ENDIF                                                                                                                                                                                                                                                  
else                                                                                                                                                                                                                                                      
   IF LX2 = 0                                                                                                                                                                                                                                             
      tot_pg = 1                                                                                                                                                                                                                                          
   ELSE                                                                                                                                                                                                                                                   
      if MOD(n2,8)#0                                                                                                                                                                                                                                      
         tot_pg = lx2+1                                                                                                                                                                                                                                   
      else                                                                                                                                                                                                                                                
         tot_pg = lx2                                                                                                                                                                                                                                     
      endif                                                                                                                                                                                                                                               
   ENDIF                                                                                                                                                                                                                                                  
endif                                                                                                                                                                                                                                                     
CT=0                                                                                                                                                                                                                                                      
DO While !mstop                                                                                                                                                                                                                                           
   CT=CT+1                                                                                                                                                                                                                                                
   nCntr = 0                                                                                                                                                                                                                                              
   F6 = 'CTRPRN'                                                                                                                                                                                                                                          
   SELE 6                                                                                                                                                                                                                                                 
   SET EXCLU OFF                                                                                                                                                                                                                                          
   USE &DR&F6                                                                                                                                                                                                                                             
   nCntr = CNTR+1                                                                                                                                                                                                                                         
   IF REC_LOCK()                                                                                                                                                                                                                                          
      REPL CNTR WITH nCntr                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   SELE 3                                                                                                                                                                                                                                                 
   IF CT=1                                                                                                                                                                                                                                                
      DO CASE                                                                                                                                                                                                                                             
      CASE NCNTR<10                                                                                                                                                                                                                                       
         NOFT='0000'+STR(NCNTR,1)                                                                                                                                                                                                                         
      CASE NCNTR<100                                                                                                                                                                                                                                      
         NOFT= '000'+STR(NCNTR,2)                                                                                                                                                                                                                         
      CASE NCNTR<1000                                                                                                                                                                                                                                     
         NOFT='00'+STR(NCNTR,3)                                                                                                                                                                                                                           
      case Ncntr<10000                                                                                                                                                                                                                                    
         NOFT='0'+STR(NCNTR,4)                                                                                                                                                                                                                            
      OTHER                                                                                                                                                                                                                                               
         noft=str(Ncntr,5)                                                                                                                                                                                                                                
      ENDCASE                                                                                                                                                                                                                                             
   ENDIF                                                                                                                                                                                                                                                  
   mstop = .t.                                                                                                                                                                                                                                            
   do HEAD1                                                                                                                                                                                                                                               
   BR=20                                                                                                                                                                                                                                                  
   SELECT 2                                                                                                                                                                                                                                               
   DO WHILE !EOF()                                                                                                                                                                                                                                        
      IF BR>24                                                                                                                                                                                                                                            
*         SKIP                                                                                                                                                                                                                                            
         MSTOP=.F.                                                                                                                                                                                                                                        
         EXIT                                                                                                                                                                                                                                             
      ENDIF                                                                                                                                                                                                                                               
      KDSH=AREA_CODE+SUB_AREACO+PRO_CODE                                                                                                                                                                                                                  
      @ BR,2 SAY KDSH                                                                                                                                                                                                                                     
      @ BR,09 SAY SHRT_DESCR                                                                                                                                                                                                                              
      IF AREA_CODE<>'E'                                                                                                                                                                                                                                   
         @ BR,39 SAY DOC_CODE                                                                                                                                                                                                                             
         @ BR,45 SAY DOC_ALIAS                                                                                                                                                                                                                            
      ENDIF                                                                                                                                                                                                                                               
      @ BR,63 SAY PROC_X                                                                                                                                                                                                                                  
      PROPAY=PROC_PAY                                                                                                                                                                                                                                     
      DO SAYG WITH BR,71,PROPAY,'99,999.99','9,999,999'                                                                                                                                                                                                   
      TOTMED=TOTMED+PROC_PAY                                                                                                                                                                                                                              
      TOTALL=TOTALL+PROC_PAY                                                                                                                                                                                                                              
      SELECT 2                                                                                                                                                                                                                                            
      SKIP                                                                                                                                                                                                                                                
      BR=BR+1                                                                                                                                                                                                                                             
   ENDDO                                                                                                                                                                                                                                                  
   BR=29                                                                                                                                                                                                                                                  
   SELECT 3                                                                                                                                                                                                                                               
   DO WHILE !EOF()                                                                                                                                                                                                                                        
      IF BR>36                                                                                                                                                                                                                                            
         SELE 3                                                                                                                                                                                                                                           
         MSTOP=.F.                                                                                                                                                                                                                                        
*         SKIP                                                                                                                                                                                                                                            
         EXIT                                                                                                                                                                                                                                             
      ENDIF                                                                                                                                                                                                                                               
                                                                                                                                                                                                                                                          
      KDTEMP=PHAR_CODE                                                                                                                                                                                                                                    
      PAYTMP=PHAR_PAY                                                                                                                                                                                                                                     
      XTEM=PHAR_X                                                                                                                                                                                                                                         
      @ BR,2 SAY KDTEMP                                                                                                                                                                                                                                   
      @ BR,9 SAY RTRIM(PHAR_NAME)+' '+RTRIM(PHAR_TYPE)+' '+rtrim(PHAR_QANT)+' '+PHAR_UNIT                                                                                                                                                                 
      @ BR,49 SAY PHAR_X                                                                                                                                                                                                                                  
      @ BR,54 SAY SALE_PRICE                                                                                                                                                                                                                              
      PHAPAY=PHAR_PAY                                                                                                                                                                                                                                     
      DO SAYG WITH BR,71,PHAPAY,'99,999.99','9,999,999'                                                                                                                                                                                                   
      F10='DRUGS'                                                                                                                                                                                                                                         
      SELE 10                                                                                                                                                                                                                                             
      USE &DR&F10 INDEX &DR&F10                                                                                                                                                                                                                           
      SEEK KDTEMP                                                                                                                                                                                                                                         
      IF .NOT. EOF()                                                                                                                                                                                                                                      
         IF REC_LOCK(0)                                                                                                                                                                                                                                   
            REPL ST_ACT_TOT WITH ST_ACT_TOT-XTEM                                                                                                                                                                                                          
            REPL ST_ACT_BUY WITH INT(ST_ACT_TOT/BUY_SELL_R)                                                                                                                                                                                               
            REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R)                                                                                                                                                                                       
         ENDIF                                                                                                                                                                                                                                            
         UNLOCK                                                                                                                                                                                                                                           
      ELSE                                                                                                                                                                                                                                                
         F10='DISPOS'                                                                                                                                                                                                                                     
         USE &DR&F10 INDE &DR&F10                                                                                                                                                                                                                         
         SEEK KDTEMP                                                                                                                                                                                                                                      
         IF .NOT. EOF()                                                                                                                                                                                                                                   
           IF REC_LOCK(0)                                                                                                                                                                                                                                 
              REPL ST_ACT_TOT WITH ST_ACT_TOT-XTEM                                                                                                                                                                                                        
              REPL ST_ACT_BUY WITH INT(ST_ACT_TOT/BUY_SELL_R)                                                                                                                                                                                             
              REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R)                                                                                                                                                                                     
           ENDIF                                                                                                                                                                                                                                          
           UNLOCK                                                                                                                                                                                                                                         
         ENDIF                                                                                                                                                                                                                                            
      ENDIF                                                                                                                                                                                                                                               
      TOTPHR=TOTPHR+PAYTMP                                                                                                                                                                                                                                
      TOTALL=TOTALL+PAYTMP                                                                                                                                                                                                                                
      SELECT 3                                                                                                                                                                                                                                            
      SKIP                                                                                                                                                                                                                                                
      BR=BR+1                                                                                                                                                                                                                                             
   ENDDO                                                                                                                                                                                                                                                  
   if !mstop                                                                                                                                                                                                                                              
      DO EJECT                                                                                                                                                                                                                                            
*      EJECT                                                                                                                                                                                                                                              
      loop                                                                                                                                                                                                                                                
   endif                                                                                                                                                                                                                                                  
   @ 40,9  SAY AEACURR                                                                                                                                                                                                                                    
   DO SAYG WITH 40,13,TOTMED,'99,999.99','9,999,999'                                                                                                                                                                                                      
   @ 40,36 SAY aeacurr                                                                                                                                                                                                                                    
   DO SAYG WITH 40,40,TOTPHR,'99,999.99','9,999,999'                                                                                                                                                                                                      
   @ 40,64 SAY aeacurr                                                                                                                                                                                                                                    
   DO SAYG WITH 40,71,TOTALL,'99,999.99','9,999,999'                                                                                                                                                                                                      
*  IF PL19=2 .or. paymode='CARD'                                                                                                                                                                                                                          
   IF PRTDIAG                                                                                                                                                                                                                                             
      @ 41, 2 SAY 'Diagnosis : '+subs(DIAGNAME,1,35)                                                                                                                                                                                                      
   ENDIF                                                                                                                                                                                                                                                  
      @ 41,64  SAY AEABCUR                                                                                                                                                                                                                                
      DO SAYG WITH 41,71,OTAMO,'9,999,999','9,999,999'                                                                                                                                                                                                    
*  ENDIF                                                                                                                                                                                                                                                  
   BR = 43                                                                                                                                                                                                                                                
   cl = 2                                                                                                                                                                                                                                                 
   cl2 = 25                                                                                                                                                                                                                                               
   cl3 = 37                                                                                                                                                                                                                                               
   IF TOTALL = 0                                                                                                                                                                                                                                          
      do No_charge                                                                                                                                                                                                                                        
   Else                                                                                                                                                                                                                                                   
      do Charge                                                                                                                                                                                                                                           
   Endif                                                                                                                                                                                                                                                  
ENDDO                                                                                                                                                                                                                                                     
EJECT                                                                                                                                                                                                                                                     
SET DEVI TO SCREE                                                                                                                                                                                                                                         
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
Procedure No_charge                                                                                                                                                                                                                                       
*------------------                                                                                                                                                                                                                                       
IF HEALTH=.T.                                                                                                                                                                                                                                             
   @ BR, 25   SAY "P. P R O G R A M   F O R M"                                                                                                                                                                                                            
   @ BR+1,25  SAY "--------------------------"                                                                                                                                                                                                            
   do DECL_MD                                                                                                                                                                                                                                             
   BR = 49                                                                                                                                                                                                                                                
   @ BR, CL  SAY "The cost of this treatment is entirely borne by P.PROGRAM, a prepaid"                                                                                                                                                                   
   @ BR+1,CL SAY "medical care program offered by "+alltrim(AEANAME)                                                                                                                                                                                      
ENDIF                                                                                                                                                                                                                                                     
IF PILC=9                                                                                                                                                                                                                                                 
   @ BR, 25  SAY " N O   C H A R G E   F O R M "                                                                                                                                                                                                          
   @ BR, 25  SAY " --------------------------- "                                                                                                                                                                                                          
   do DECL_MD                                                                                                                                                                                                                                             
   BR = 49                                                                                                                                                                                                                                                
   @ BR, cl SAY "The cost of this treatment is entirely borne by"                                                                                                                                                                                         
   @ BR, cl say AEANAME +"."                                                                                                                                                                                                                              
endif                                                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
Procedure Charge                                                                                                                                                                                                                                          
*---------------                                                                                                                                                                                                                                          
DO CASE                                                                                                                                                                                                                                                   
   CASE PILC=3                                                                                                                                                                                                                                            
      @ BR,   25  SAY "P A Y M E N T   R E C E I P T"                                                                                                                                                                                                     
      @ BR+1, 25  SAY "-----------------------------"                                                                                                                                                                                                     
      do DECL_MD                                                                                                                                                                                                                                          
      BR = 49                                                                                                                                                                                                                                             
      if pl19=2 .or. paymode='CARD'                                                                                                                                                                                                                       
         @ br,cl say "Paid, the sum of : "+otcur+' '+trans(otamo,'##,###,###')+' ('+aeacurr+' '+trans(totall,'##,###.##')+') '+'by : '+paymode                                                                                                            
      else                                                                                                                                                                                                                                                
         @ br,cl say "Paid, the sum of : "+AEACURR                                                                                                                                                                                                        
         DO SAYG WITH BR,25,TOTALL,'999,999.99','99,999,999'                                                                                                                                                                                              
         @ BR,37 say 'by : '+paymode                                                                                                                                                                                                                      
      endif                                                                                                                                                                                                                                               
                                                                                                                                                                                                                                                          
   OTHER                                                                                                                                                                                                                                                  
      @  BR,   25  SAY "C R E D I T   V O U C H E R"                                                                                                                                                                                                      
      @  BR+1, 25  SAY "---------------------------"                                                                                                                                                                                                      
      if pilc=7                                                                                                                                                                                                                                           
	@ 46, 2 SAY 'I,Mr/Ms ' + RTRIM(FNMPAT)+' '+NMPAT + ', Dependant of '+depper                                                                                                                                                                              
	@ 47, 2 SAY ' have received MEDICAL TREATMENT at the '                                                                                                                                                                                                   
	@ 48, 2 SAY AEANAME + ' on ' + subs(dtoc(DATE()),1,2) + '/' + subs(dtoc(DATE()),4,2) + '/' + subs(dtoc(DATE()),7,4)                                                                                                                                      
	@ 50, 2 SAY "Send Invoice to : "+ AEANAME + " Tel :"+alltrim(atelp)                                                                                                                                                                                      
	@ 51, 2 SAY "to the attention of : Personnel Department"                                                                                                                                                                                                 
      else                                                                                                                                                                                                                                                
	do DECL_MD                                                                                                                                                                                                                                               
	BR = 49                                                                                                                                                                                                                                                  
	DO CASE                                                                                                                                                                                                                                                  
	   CASE PILC=2                                                                                                                                                                                                                                           
*    @ BR,CL say "Paid, the sum of : "+AEACURR                                                                                                                                                                                                            
*    DO SAYG WITH 49,25,PARTCASH,'999,999.99','99,999,999'                                                                                                                                                                                                
*    @ BR,37 say 'by : '+paymode                                                                                                                                                                                                                          
*    @ BR+1,CL SAY "The balance payable to the Clinic for this treatment is : "+AEACURR                                                                                                                                                                   
*    DO SAYG WITH BR+1,67,PARTCRED,'999,999.99','99,999,999'                                                                                                                                                                                              
                                                                                                                                                                                                                                                          
                 IF PL19=2                                                                                                                                                                                                                                
                    @ BR,CL say "Paid, the sum of : "+otcur+' '+trans(partothe,'##,###,###')+' ('+aeacurr+' '+trans(partcash,'##,###.##')+') by :'+paymode                                                                                                
                 ELSE                                                                                                                                                                                                                                     
                    @ BR,CL say "Paid, the sum of : "+AEACURR                                                                                                                                                                                             
                    DO SAYG WITH 49,25,PARTCASH,'999,999.99','99,999,999'                                                                                                                                                                                 
                    @ BR,37 say 'by : '+paymode                                                                                                                                                                                                           
                 ENDIF                                                                                                                                                                                                                                    
                 @ BR+1,CL  SAY "The balance payable to the Clinic for this treatment is : "+AEACURR                                                                                                                                                      
                 DO SAYG WITH BR+1,67,PARTCRED,'999,999.99','99,999,999'                                                                                                                                                                                  
                                                                                                                                                                                                                                                          
	   CASE PILC=4                                                                                                                                                                                                                                           
	     @ BR,CL   SAY "Your P.PROGRAM renewal has not been processed, yet"                                                                                                                                                                                  
	     @ BR+1,CL SAY "The amount payable to the Clinic for this treatment is  : "+AEACURR                                                                                                                                                                  
	     DO SAYG WITH BR+1,67,TOTALL,'999,999.99','99,999,999'                                                                                                                                                                                               
	   OTHER                                                                                                                                                                                                                                                 
	     IF AUTHOR<>SPACE(16)                                                                                                                                                                                                                                
		@ BR,CL SAY "CREDIT AUTHORIZED BY : "+AUTHOR PICT "@!"                                                                                                                                                                                                  
		BR=BR+1                                                                                                                                                                                                                                                 
	     ENDIF                                                                                                                                                                                                                                               
	     @ BR,CL SAY "The amount payable to the Clinic for this treatment is  : "+AEACURR                                                                                                                                                                    
	     DO SAYG WITH BR,67,TOTALL,'999,999.99','99,999,999'                                                                                                                                                                                                 
	ENDCASE                                                                                                                                                                                                                                                  
	@  51,  2  SAY "Invoice to : _____________________________________ Tel : ________________"                                                                                                                                                               
	@  52,  2  SAY "Company : _______________________________________________________________"                                                                                                                                                               
	@  53,  2  SAY "Address : _______________________________________________________________"                                                                                                                                                               
	@  54,  2  say "          ________________________________________ Tel : ________________"                                                                                                                                                               
	@  55,  2  SAY "to the attention of : ________________________(Name of Authorized Person)"                                                                                                                                                               
      ENDIF                                                                                                                                                                                                                                               
ENDCASE                                                                                                                                                                                                                                                   
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
Procedure HEAD1                                                                                                                                                                                                                                           
*----------------                                                                                                                                                                                                                                         
                                                                                                                                                                                                                                                          
page=page+1                                                                                                                                                                                                                                               
@  5, 2 SAY ALLTRIM(USERNM)                                                                                                                                                                                                                               
@  5, 66  SAY  a+'/'+str(MONTH(DATE()),2)+'/'+NOFT                                                                                                                                                                                                        
@  6, 74  SAY str(page,1) + '/' + str(tot_pg,1)                                                                                                                                                                                                           
@  6, 2   SAY "Current Time : "+time()    && 95-9-19 Rocky modify                                                                                                                                                                                         
@  9, 69  SAY DATE()                                                                                                                                                                                                                                      
@ 10, 69  SAY KDPAT                                                                                                                                                                                                                                       
@ 15, 11  SAY NMPAT                                                                                                                                                                                                                                       
@ 15, 41  SAY FNMPAT                                                                                                                                                                                                                                      
@ 15, 73  SAY MNMPAT                                                                                                                                                                                                                                      
@ 16, 17  SAY subs(dtoc(DOBPAT),1,2) + '/' + subs(dtoc(DOBPAT),4,2) + '/' + subs(dtoc(DOBPAT),7,4)                                                                                                                                                        
@ 16, 43  SAY NATIO                                                                                                                                                                                                                                       
@ 16, 73  SAY ISEX                                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
Procedure DECL_MD                                                                                                                                                                                                                                         
*-----------------                                                                                                                                                                                                                                        
@ 46, 2 SAY 'I,Mr/Ms ' + RTRIM(FNMPAT)+' '+NMPAT + ' have received MEDICAL TREATMENT'                                                                                                                                                                     
@ 47, 2 SAY 'at the ' + AEANAME + ' on ' + subs(dtoc(DATE()),1,2) + '/' + subs(dtoc(DATE()),4,2) + '/' + subs(dtoc(DATE()),7,4)                                                                                                                           
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
Procedure EjectLA                                                                                                                                                                                                                                         
*--------------                                                                                                                                                                                                                                           
prow = prow()                                                                                                                                                                                                                                             
skip_line = 66 - prow                                                                                                                                                                                                                                     
SET CONSOLE OFF                                                                                                                                                                                                                                           
For i = 1 to skip_line                                                                                                                                                                                                                                    
    ?                                                                                                                                                                                                                                                     
next i                                                                                                                                                                                                                                                    
?                                                                                                                                                                                                                                                         
?                                                                                                                                                                                                                                                         
?                                                                                                                                                                                                                                                         
?                                                                                                                                                                                                                                                         
?                                                                                                                                                                                                                                                         
?                                                                                                                                                                                                                                                         
SET CONSOLE ON                                                                                                                                                                                                                                            
setprc(0,0)                                                                                                                                                                                                                                               
                                                                                                                                                                                                                                                          
Procedure Eject                                                                                                                                                                                                                                           
*--------------                                                                                                                                                                                                                                           
prow = prow()                                                                                                                                                                                                                                             
skip_line = 66 - prow                                                                                                                                                                                                                                     
SET CONSOLE OFF                                                                                                                                                                                                                                           
For i = 1 to skip_line                                                                                                                                                                                                                                    
    ?                                                                                                                                                                                                                                                     
next i                                                                                                                                                                                                                                                    
?                                                                                                                                                                                                                                                         
?                                                                                                                                                                                                                                                         
?                                                                                                                                                                                                                                                         
?                                                                                                                                                                                                                                                         
?                                                                                                                                                                                                                                                         
?                                                                                                                                                                                                                                                         
SET CONSOLE ON                                                                                                                                                                                                                                            
setprc(0,0)                                                                                                                                                                                                                                               
